***
***
*** This Program already converted to Y2K
*** S&T Departement     on 29 April 1999 by Ben.Rahman
***
***
set cent on
SET COLO TO BG+/B
CLEAR
SET PROC TO SOSPRO1
SET PROC TO BOXPROC
SET PROC TO LABPROC
STORE ' ' TO AEANAME,AEAADDR,AEACITY,AEACOUN,AEACURR,AEASTNM
STORE .F. TO AEAHEAL,AEADECI,AEASITE,FLAGPULL
STORE SPACE(15) TO PRGNM
STORE 0 TO PIL5,PIL6,PHARPAY,XTEM,TOTPHR,GRTOTPHR,VAT,NVAT,COST_PRICE
STORE SPACE(5) TO KDTEMP
STORE SPACE(12) TO SERIAL
STORE SPACE(40) TO CORP
* Thien added on 18/Jun/2010
* To get system params
DO START
* End Thien
REST FROM  N:VISPHA addi
PUBLIC VISPH
DR="N:"
DOI=DATE()
store 0 to SWW,sww1,sww2,sww3,cr1,cnt1,PL1,PL2,PL3,PL4,PL5,PL6,PL7,PL8,PL9,PL10,pl11,pl12,PL13,PL14,PL15,PL16,PL17,PL18
store 0 to ndrug, NDISP, prn_no, srv_charge
STORE .F. TO PATIN,FRUSEL,COMPLT,termin,patid
TGLL=SUBSTR(DTOC(DOI),1,2)

DO WHILE .NOT. PATIN .AND. SWW<3 .AND. LASTKEY()<>27
	SET COLOR TO BG+/B
	@ 0,0 CLEA TO 24,79
	STORE 0 TO TOTL,NPROC,TOTPAY,TOTHL,TOTFEE,TOTPROC,NORE,DQNT,PTOTL,PILC,MTOTL
	STORE SPACE(6) TO KDPAT,KODE
	STORE SPACE(1) TO TPPAT,CRPAT,MNMPAT,ISEX
	STORE SPACE(4) TO DTPAT,COPAT
	STORE SPACE(8) TO MDSNBR
	STORE SPACE(16) TO NMPAT,FNMPAT,NATIO,DEPPER
	STORE CTOD('  /  /    ') TO DOBPAT,HLBEGIN,MDSDAT,PREVDATE,CURRDATE
	STORE .F. TO HEALTH, HLRES, HLVOID,PERSO,FAMIL,MDS,PREND
	HLDATE=DATE()
	F1='IN_PAT'
	F2='PHARMACY'
	F22='SEQPRN'
	SELE 1
	SET EXCLU OFF
	USE &DR&F1
	DO ADDRESSC
	DO BOXT WITH 3,29,'PHARMACY 10Jul10','W+','B',.F.,.T.
	SET COLO TO BG+/B
	@ 6, 3 SAY "SURNAME :"
	@ 6,30 SAY "FIRST NAME :"
	@ 6,60 SAY "MID.INITIAL :"
	@ 7, 3 SAY "DATE OF BIRTH :"
	@ 7,29 SAY "NATIONALITY :"
	@ 7,62 SAY "SEX (M/F) :"
	DO BOXE WITH 3,52,'PATIENT CODE :','KODE','GR+','R','N','W+',6,.F.,.T.
	SET COLO TO BG+/B,W+/N
	IPPAT=.F.
	SELE 1
   	LOCA FOR PAT_FILCOD=KODE
	IF .NOT. FOUND()
		SWW=SWW+1
		SET COLO TO BG+/B*
		set cons off
		DO BOXF WITH 14,17,'>>>>> WRONG CODE, PLEASE ENTER AGAIN <<<<<','GR+','R','GR+*',.T.,.T.
		WAIT ' '
		set cons on
		SET COLO TO BG+/B
		@ 14,17 CLEA TO 23,78
		PATID=.F.
	ELSE
		PATID=.T.
	ENDIF
	IF PATID
		DO cashipat
		DO BOX2 WITH 20,20,'DO YOU WANT TO :','CONFIRM','CANCEL','W+','B','GR+','N',PL1,.T.,.T.
		IF PL1=1
			PATIN=.T.
		ENDIF
	ENDIF
ENDDO

IF .NOT. PATIN
	RETURN
ENDIF

nore=recno()
F2='PHARMACY'
fill='\temp\la'+kdpat+'.dbf'
film='\temp\ME'+kdpat+'.dbf'
filp='\temp\ph'+kdpat+'.dbf'
*IF FILE("&DR&FILM") .OR. FILE("&DR&FILP")
*   @ 10,1 CLEA TO 23,78
*   DO BOXT WITH 14,20,"   THIS FILE IS USED AT CASHIER STATION   ",'GR+','B',.F.,.F.
*   DO BOXT WITH 16,20,"YOU CANNOT PROCESS LABORATORY EXAMINATIONS",'GR+','B',.F.,.F.
*   DO BOXT WITH 18,20,"    PLEASE, RETURN THE FILE TO CASHIER    ",'GR+','B',.F.,.F.
*   DO BOXT WITH 20,20,"   AND,  TYPE ANY KEY TO RETURN TO MENU   ",'GR+','B',.F.,.F.
*   WAIT " "
*   CLEA
*   RETURN
*ENDIF
F6="\temp\PR"+kdpat

** Generating SeqNo
* Added by Thien on 07 Jul 2010
F22="DATEPRN"
F23="SEQPRN"
STORE 0 TO nSEQ
CURRDATE=DATE()
nSEQ = 0
SELE 22
SET EXCLU OFF
USE &DR&F22
IF .NOT. EOF()
  PREVDATE=PREV_DATE
ELSE
  PREVDATE=CURRDATE
ENDIF

IF CURRDATE>PREVDATE
* Not in the same date
* Assign curr date to prev date and write it to DATEPRN table
* Reset SEQNO to 1
  PREVDATE=CURRDATE
  IF REC_LOCK()
    REPL PREV_DATE WITH PREVDATE
  ENDIF
  nSEQ = 1
ELSE
* Same date to perform:
* -- Read last Seq
* -- Replace last Seq = last Seq + 1
  SELE 23
  SET EXCLU OFF
  USE &DR&F23
  IF .NOT. EOF()
    nSEQ=SEQNO+1
  ENDIF
  IF nSEQ>999
    nSEQ = 1
  ENDIF
ENDIF
SELE 23
SET EXCLU OFF
USE &DR&F23
IF REC_LOCK()
  REPL SEQNO WITH nSEQ
ENDIF

STORE SPACE(4) TO YEARP
STORE SPACE(2) TO MONTHP
STORE SPACE(2) TO DATEP
STORE SPACE(3) TO SEQNOP

YEARP=str(year(CURRDATE),4)
IF MONTH(CURRDATE) < 10
  MONTHP='0'+str(month(CURRDATE),1)
ELSE
  MONTHP=str(month(CURRDATE),2)
ENDIF
IF DAY(CURRDATE) < 10
  DATEP='0'+str(day(CURRDATE),1)
ELSE
  DATEP=str(day(CURRDATE),2)
ENDIF
IF nSEQ < 10
  SEQNOP = '00'+str(nSEQ,1)
ELSE
  IF nSEQ < 100
    SEQNOP = '0'+str(nSEQ,2)
  ELSE
    SEQNOP = str(nSEQ,3)
  ENDIF
ENDIF
SERIAL=YEARP+MONTHP+DATEP+'-'+SEQNOP
** End Thien 07 Jul 2010
use &dr&f2
copy stru to &dr&f6
sele 6
use &dr&f6
SET COLOR TO BG+/B
@ 11,0 CLEAR to 24,79
VISPH=VISPH+1
NOBER=STR(VISPH,5)
STORE 0 TO TOTL,PHACNT
*DO WHILE .NOT.TERMIN
DO WHILE .NOT. COMPLT
	STORE .F. TO MRES,HRES
	STORE 0 TO PLAB,MLAB,HLAB,COSTAL,NUMB,pub
	set color to bg+/b
	@ 9,0 clea to 18,45
	@ 19,0 CLEA TO 24,79
	DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'#,##9.99'),'GR+','B',.F.,.T.
	F9='DRUGS'
	F10='DISPOS'
**   SELE 9
 **  SET EXCLU OFF
  ** USE &DR&F9 INDEX &DR&F9
*   SELE 10
*   SET EXCLU OFF
*   USE &DR&F10 INDE &DR&F10

	ANOD=.T.
	do while anod
		set color to bg+/b
		@ 9,0 clea to 21,79
		@ 22,0 CLEA TO 24,45
		store space(5) to DRUGK,dispk
		store 0 to cntd,crd,DQNT
		STORE SPACE(3) TO DRUGIN,DISPIN
		do box2 with 9,0,"DELIVERY OF :","MEDICATIONS (DRUGS)","DISPOSABLE ITEMS",'w+','bg','w+','n',pl6,.f.,.t.
		if PL6=1
			F9='DRUGS'
			F9A='DRUGNM'
			DRUGK=space(5)
         *DO BOXlab WITH 12,0,'Enter Drugs Code :','DRUGK','gr+','B','gr+','N',5,.F.,.T.
			if DRUGK=SPACE(5)
				do boxe with 12,28,'Enter Init 3 chars of Drug Name: ','DRUGIN','N','BG','W+','N',3,.T.,.T.
				*@18, 15 SAY "Your enter: " + DRUGIN
				DO CASH405
				if drugk=space(5)
					loop
				endif
			ENDIF
			SET COLOR TO BG+/B
			@ 9,0 CLEA TO 21,79
			SELE 9
			set exclu off
			use &dr&f9 inde &dr&f9
			SEEK DRUGK
			IF .NOT. EOF()
				NMDR=DRUG_NAME
				TPDR=DRUG_TYPE
				SLUN=TRIM(SELL_UNIT)+' '+TRIM(DRUG_QANT)+' '+TRIM(DRUG_UNIT)
				SEUN=SELL_UNIT
				*         IF TPPAT='0' .OR. TPPAT='9'				
				*             UNPR=EMP_PRICE
				*             ELSE
				*           IF TPPAT='7'
				*              UNPR=TMS_PRICE
				*           ELSE
				UNPR=SALE_PRICE
				*           ENDIF
				*         ENDIF

				*            IF TPPAT='7'
				*               UNPR=TMS_PRICE
				*            ELSE
				*               UNPR=SALE_PRICE
				*            ENDI

				**
				**            UNPR=SALE_PRICE
** HUY ADDED 3 OCT 06 ' No surcharge on some item in DP_DICS            

**	IF ALLTRIM(PRGNM) = "TOURIST" .OR. ALLTRIM(PRGNM) = "VISITOR"
				
**		IF ALLTRIM(DRUGK)='FV001' .OR. ALLTRIM(DRUGK)='V0059'

**         		@ 10,45 SAY 'Normal % '
**			unPR=uNPR
**                ELSE
**			@ 10,45 SAY 'Surcharge 20 % '
**			UNPR=UNPR * 1.2  
**	    	ENDIF
                                                                                 
**  	ENDIF                         



** HUY END 3 OCT 06 ' No surcharge on some item in DP_DICS
				UNNI=DRUG_UNIT
            	QANT=DRUG_QANT
            	HLDR=HEALTHLINE
				IF ALLTRIM(PRGNM) = "CMPP PROGRAM"
					@ 19, 03 SAY 'CMPP For Free'
					F5='DP_DISC'
					sele 15
					SET EXCLU OFF
					use &dr&F5 inde &dr&F5
					GO TOP
					SEEK PRGNM+DRUGK
					IF .NOT. EOF()
						@ 20,03 SAY 'Total Price ('+AEACURR+'):  '+TRANS(TOTPR,'#,###,###.##')+ '  before 100% discount for CMPP'
						UNPR = 0.0
					ELSE
						@ 20, 03 SAY 'Unit Price: ' +TRANS(UNPR,'#,###,###.##')
					ENDIF
				ENDIF

				DO BOXT WITH 9,0,ALLTRIM(NMDR)+' '+ALLTRIM(TPDR)+'  '+SLUN,'W+','B',.F.,.F.
				DO BOXT WITH 11,0,'Price (VND) :'+TRANS(unPR,'##,###,###')+' Per '+alltrim(seun),'W+','b',.F.,.T.
				DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
				DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
				if dqnt=1
					DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
				else
					DO BOXT WITH 11,56,alltrim(SEUN)+'s','bg+','B',.F.,.F.
				endif
				TOTPR=UNPR*DQNT
				DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,###,###'),'W+','R',.F.,.T.
				do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
				IF PL7=2
					loop
				ELSE
					NDRUG=NDRUG+1
					IF TPPAT='0' .OR. TPPAT='9'
						IF EMDR
							HLRES=.F.
							HPRIC=0
							PPRIC=0
							MPRIC=0
							MSRES=.F.
						ELSE
							HLRES=.F.
							HPRIC=0
							PPRIC=TOTPR
							MPRIC=0
							MSRES=.F.
						ENDIF
					ELSE
						IF TPPAT='7'
							HLRES=.F.
							HPRIC=0
							PPRIC=TOTPR
							MPRIC=0
							MSRES=.F.
						ELSE
							IF HLDR .AND. HEALTH .AND. .NOT. HLVOID
								HLRES=.T.
								HPRIC=TOTPR
								PPRIC=0
								MPRIC=0
								MSRES=.F.
							ELSE
								IF MDS
									HLRES=.F.
									HPRIC=0
									PPRIC=0
									MPRIC=TOTPR
									MSRES=.T.
								ELSE
									HLRES=.F.
									HPRIC=0
									MPRIC=0
									PPRIC=TOTPR
									MSRES=.F.
								ENDIF
							ENDIF
						endif
					ENDIF
					sele 6
					DO phadr
					TOTL=TOTL+PPRIC
					PTOTL=PTOTL+PPRIC
				endif
			ELSE
			** -- EOF -- **
          *store space(25) to nmdr
          *store space(16) to tpdr,slun,seun,unni,qant
          *store 0 to unpr,dqnt
          *store .f. to hldr,msdr
          *DO BOXE  WITH 9,0,"DRUGS NAME :",'NMDR','BG+','B','W+','N',16,.F.,.F.
          *DO BOXCS WITH 11,0,'Price (VND) : ','unpr','999,999','BG+','B','W+','N','1000000','0',.F.,.F.
          *DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
          *TOTPR=UNPR*DQNT
          *DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,##9.99'),'W+','R',.F.,.T.
          *do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
          *IF PL7=2
          *   loop
          *ELSE
          *   HLRES=.F.
          *   HPRIC=0
          *   MPRIC=0
          *   PPRIC=TOTPR
          *   MSRES=.F.
          *ENDIF
          *SELE 6
          *DO phaDR
          *TOTL=TOTL+PPRIC
          *PTOTL=PTOTL+PPRIC
			ENDIF
			DO BOXT WITH 19,46,'PHAR. PAYABLE (VND) :'+TRANS(PTOTL,'##,###,###'),'GR+','b',.F.,.T.
			DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'##,###,###'),'GR+','b',.F.,.T.
		else
		** -- PL6=2 Process Dispos -- **
			DispK=space(5)
			STORE(3) TO DISPIN
      *DO BOXlab WITH 12,0,'Enter Disposable Code :','DispK','gr+','B','gr+','N',5,.F.,.T.
			if Dispk=SPACE(5)
				F10='DISPOS'
				F10A='DISPNM'
				*do boxe with 12,33,'Enter Init of 3 chars Disp Name: ','dispin','gr+','b','gr+','n',3,.f.,.t.
				do boxe with 12,33,'Enter Init 3 chars of Disp Name: ','DISPIN','N','BG','W+','N',3,.T.,.T.
        DO CASH406
				if dispk=space(5)
					loop
				endif
			endif
			SET COLOR TO BG+/B
			@ 9,0 CLEA TO 20,79
			SELE 10
			set exclu off
			use &dr&f10 inde &dr&f10
			SEEK DISPK
			IF .NOT. EOF()
				NMDS=DISP_NAME
				TPDS=DISP_TYPE
				SLUN=TRIM(SELL_UNIT)+' '+TRIM(DISP_QANT)+' '+TRIM(DISP_UNIT)
				SEUN=SELL_UNIT
         *IF TPPAT='0' .OR. TPPAT='9'
         *  UNPS=EMP_PRICE
         *ELSE
         *  IF TPPAT='7'
         *     UNPS=TMS_PRICE
         *  ELSE
				UNPS=SALE_PRICE
         *  ENDIF
         *ENDIF
**            UNPS=SALE_PRICE
				UNNI=DISP_UNIT
				QANT=DISP_QANT
				HLDS=HEALTHLINE
				DO BOXT WITH 9,0,ALLTRIM(NMDS)+' '+ALLTRIM(TPDS)+'  '+SLUN,'W+','B',.F.,.F.
				DO BOXT WITH 11,0,'Price : (VND) '+TRANS(UNPS,'##,###,###')+' Per '+alltrim(seun),'bg+','b',.F.,.T.
				DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
				DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
				TOTPR=UNPS*DQNT
				DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,###,###'),'w+','r',.F.,.T.
				do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
				IF PL7=2
					loop
				ELSE
					NDISP=NDISP+1
					IF TPPAT='0' .OR. TPPAT='9'
**               IF TPPAT='0' .OR. TPPAT='9' .OR. TPPAT='7'
					IF EMDS
						HLRES=.F.
						HPRIC=0
						PPRIC=0
						MPRIC=0
						MSRES=.F.
					ELSE
						HLRES=.F.
						HPRIC=0
						PPRIC=TOTPR
						MPRIC=0
						MSRES=.F.
					ENDIF
				ELSE
					IF TPPAT='7'
						HLRES=.F.
						HPRIC=0
						PPRIC=TOTPR
						MPRIC=0
						MSRES=.F.
					ELSE
						IF HLDS .AND. HEALTH .AND. .NOT. HLVOID
							HLRES=.T.
							HPRIC=TOTPR
							PPRIC=0
							MPRIC=0
							MSRES=.F.
						ELSE
							IF MDS
								HLRES=.F.
								HPRIC=0
								MPRIC=TOTPR
								PPRIC=0
								MSRES=.T.
							ELSE
								HLRES=.F.
								HPRIC=0
								PPRIC=TOTPR
								MPRIC=0
								MSRES=.F.
							ENDIF
						ENDIF
					ENDIF
				endif
				sele 6
				DO phads
				TOTL=TOTL+PPRIC
				PTOTL=PTOTL+PPRIC
			endif
		else
			store space(25) to nmds
			store space(16) to tpds,slun,seun,unni,qant
			store 0 to unps,dqnt
			store .f. to hlds,msds
          *DO BOXE  WITH 9,0,"DISPOSABLE NAME :",'NMDS','BG+','B','W+','N',16,.F.,.F.
          *DO BOXCS WITH 11,0,'Price (VND) : ','unps','999,999','BG+','B','W+','N','1000000','0',.F.,.F.
          *DO BOXCS WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
			TOTPR=UNPS*DQNT
          *DO BOXT WITH 14,0,'TOTAL PRICE (VND) :'+TRANS(TOTPR,'##,##9.99'),'W+','R',.F.,.T.
          *do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
          *IF PL7=2
          *   loop
          *ELSE
          *   HLRES=.F.
          *   HPRIC=0
          *   MPRIC=0
          *   PPRIC=TOTPR
          *   MSRES=.F.
          *ENDIF
          *ELE 6
          *DO phads
          *TOTL=TOTL+PPRIC
          *PTOTL=PTOTL+PPRIC
		endif
		DO BOXT WITH 19,46,'PHAR. PAYABLE (VND) :'+TRANS(PTOTL,'##,###,###'),'GR+','B',.F.,.T.
		DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(TOTL,'##,###,###'),'GR+','B',.F.,.T.
	ENDIF
	SET COLOR TO BG+/B
	@ 9,0 CLEA TO 18,79
	@ 20,0 CLEA TO 24,45
	DO BOX2 WITH 22,0,'Other Drugs or Disposable items :','YES','NO','gr+','r','W+','N',PL8,.F.,.t.
	if pl8=2
		anod=.f.
	endif
	ENDDO
SELE 6
if reccount()=0
	return
endif
pde=.t.
do while pde
	SET COLOR TO BG+/B
	@ 9,0 CLEA TO 24,79
	DO BOXF WITH 9,0,"REVIEW THE INVOICE. Type 'Esc' if correct, 'Enter' To Delete one item",'GR+','R','GR+*',.F.,.T.
	DO BOXT WITH 22,46,'TOTAL PAYABLE (VND) :'+TRANS(totl,'##,###,###'),'GR+','B',.F.,.T.
	GO TOP
	CNT=RECCOUNT()
	DECLARE PPRC[CNT]
	declare PHAc[cnt]
	declare fil1[cnt]
	declare recn[cnt]
	cr=0
	go top
	do while .not. eof()
		cr=cr+1
		PPRC[CR]=PHAR_PAY
		PHAc[cr]=PHAR_CODE
		fil1[cr]=PHAR_CODE+CHR(179)+SPACE(2)+PHAR_NAME+PHAR_TYPE+PHAR_QANT+' '+CHR(179)+' '+str(PHAR_X,4)+space(1)+CHR(179)+trans(SALE_PRICE,'##,##9.99')+' '+CHR(179)+' '+TRANS(PHAR_PAY,'###,##9.99')
		recn[cr]=recno()
		skip
	enddo
	set color to w+/b
	@ 17,0 to 21,79 double
	set colo to g+/B,W+/N
	pilih=achoice(18,2,20,76,fil1)
	IF LASTKEY()=13
		recdel=recn[pilih]
		PPRIC=PPRC[PILIH]
		sele 6
		go recdel
		@ 12,0 clea to 16,79
		do box2 with 12,0,'Delete item '+alltrim(PHAR_NAME)+' '+ALLTRIM(PHAR_TYPE)+' :','YES','NO','w+','b','W+','n',pl10,.f.,.f.
		if pl10=1
			STORE .T. TO PDE,PDEL
			if rec_lock(0)
				DELE
			ENDIF
			UNLOCK
			totl=totl-PPRIC
			ptotl=ptotl-ppric
			SELE 6
			USE
			IF NET_USE("&DR&F6",.T.,'6',10)
				PACK
			ENDIF
			SET EXCLU OFF
			STOR .F. TO PDE
		else
			STOR .F. TO PDE, PDEL
		endif
	else
		STOR .F. TO PDE, PDEL
	endif
enddo
SET COLOR TO BG+/B
@ 9,0 CLEA TO 21,79
@ 22,0 CLEA TO 24,45
IF PDEL
	DO BOX2 WITH 9,0,'DO YOU WANT TO REPLACE DELETED ITEMS ?','YES','NO','GR+','RB','GR+','N',PL11,.F.,.T.
	IF PL11=1
		complt=.f.
**         CLOS ALL
		LOOP
	ELSE
		COMPLT=.T.
	ENDIF
ELSE
	COMPLT=.T.
Endif
enddo

** BEGIN Print slip added on 15 Jun 2010 by Thien
SET COLOR TO BG+/B
@ 10,1 CLEA TO 23,79
DO BOX2 WITH 10,3,'SOS STAFF :','YES','NO','gr+','r','W+','N',PL8,.T.,.T.
IF PL8 = 1
  SELECT 6
  USE &DR&F6
*  IF REC_LOCK(0)
*    FLAGPULL=.T.
*    REPL FLAG_PULL WITH FLAGPULL
*  ENDIF
  DO WHILE !EOF()
    KDTEMP=PHAR_CODE                                                                                                                                                                                                                                                                                                                                                                                                                                                              
    XTEM=PHAR_X
    F9='DRUGS'                                                                                                                                                                                                                                          
    SELECT 9                                                                                                                                                                                                                                            
    SET EXCLUSIVE OFF                                                                                                                                                                                                                                   
    USE &DR&F9 INDEX &DR&F9                                                                                                                                                                                                                             
    SEEK KDTEMP                                                                                                                                                                                                                                         
    IF .NOT. EOF()                                                                                                                                                                                                                                      
      IF FOUND()
        COST_PRICE = ST_AV_PR_S                                                                                                                                                                                                                                   
          *REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                                 
          *REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                                      
          *REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)
        SELE 6
        IF Rec_LOCK(0)
          REPL SALE_PRICE WITH COST_PRICE
          REPL PHAR_PRICE WITH COST_PRICE*XTEM
          REPL PHAR_PAY WITH COST_PRICE*XTEM                                                                                                                                                                                                                 
        ENDIF                                                                                                                                                                                                                                                   
        UNLOCK                                                                                                                                                                                                                                                  
      ENDIF                                                                                                                                                                                                                                            
    ELSE                                                                                                                                                                                                                                                
      F10='DISPOS'                                                                                                                                                                                                                                            
      SELECT 10                                                                                                                                                                                                                                        
      SET EXCLUSIVE OFF                                                                                                                                                                                                                                
      USE &DR&F10 INDE &DR&F10                                                                                                                                                                                                                                
      SEEK KDTEMP                                                                                                                                                                                                                                             
      IF .NOT. EOF()                                                                                                                                                                                                                                          
        IF FOUND()                                                                                                                                                                                                                                                                                                                                                                                                                                                                      
          COST_PRICE = ST_AV_PR_S
            *REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                               
            *REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                                    
            *REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)
          SELE 6
          IF Rec_LOCK(0)
            REPL SALE_PRICE WITH COST_PRICE
            REPL PHAR_PRICE WITH COST_PRICE*XTEM
            REPL PHAR_PAY WITH COST_PRICE*XTEM                                                                                                                                                                                                        
          ENDIF                                                                                                                                                                                                                                                 
          UNLOCK                                                                                                                                                                                                                                                
        ENDIF                                                                                                                                                                                                                                          
      ENDIF                                                                                                                                                                                                                                                   
    ENDIF
    SELECT 6
    SKIP
  ENDDO
ENDIF
do while PIL6<>1 .and. pil5<>2
  SET COLOR TO BG+/B
  @ 15,1 CLEA TO 23,78
  do BOX2 WITH 15,3,"DO YOU WANT TO :",'PRINT','QUIT','GR+','RB','GR+','R',PIL5,.T.,.T.
  IF PIL5=1
    do BOX2 WITH 20,3,"IS THE PRINTER :",'READY','NOT YET READY','GR+','RB','GR+','R',PIL6,.T.,.T.
  ENDIF
enddo
IF LASTKEY()=27 .or. pil5=2
  CLOSE ALL
  RETURN
ENDIF
*DO BOXT WITH 15,53,'Printing...','GR*+','R',.T.,.T.
Set Printer to PRN                                                                                                                                                                                                                                        
Set print on                                                                                                                                                                                                                                              
set device to printer                                                                                                                                                                                                                                     
setprc(0,0)
DO HEAD1
BR=24                                                                                                                                                                                                                                                  
SELECT 6
USE &DR&F6
*GO TOP
*f3='\temp\pr'+kdpat
*USE &DR&F3
TOTPHR=0
prn_no = 0                                                                                                                                                                                                                                             
DO WHILE !EOF()                                                                                                                                                                                                                                        
*  IF BR>40                                                                                                                                                                                                                                            
*    SELE 3                                                                                                                                                                                                                                                  
*    MSTOP=.F.                                                                                                                                                                                                                                               
*    EXIT                                                                                                                                                                                                                                                    
*  ENDIF                                                                                                                                                                                                                                               
																															  
  KDTEMP=PHAR_CODE                                                                                                                                                                                                                                                                                                                                                                                                                                                              
  XTEM=PHAR_X     
  PHAPAY=PHAR_PAY
  PAYTMP=PHAR_PAY
  prn_no = prn_no + 1
	
  DO SAYG WITH BR,6,prn_no,'99','99'                                                                                                                                                                                                                                 
  @ BR,9 SAY KDTEMP                                                                                                                                                                                                                                   
  @ BR,15 SAY RTRIM(PHAR_NAME)+' '+RTRIM(PHAR_TYPE)+' '+rtrim(PHAR_QANT)                                                                                                                                                                              
  @ br,47 say PHAR_UNIT                                                                                                                                                                                                                               
  @ BR,51 SAY PHAR_X                                                                                                                                                                                                                                  
  DO SAYG WITH BR,55,ROUND(PHAR_PAY/PHAR_X,0),'99,999.99','99,999,999'                                                                                                                                                                                                                                                                                                                                                                                                                                                                       
  DO SAYG WITH BR,65,PHAPAY,'99,999.99','99,999,999'                                                                                                                                                                                                   
*  F9='DRUGS'                                                                                                                                                                                                                                          
*  SELECT 9                                                                                                                                                                                                                                            
*  SET EXCLUSIVE OFF                                                                                                                                                                                                                                   
*  USE &DR&F9 INDEX &DR&F9                                                                                                                                                                                                                             
*  SEEK KDTEMP                                                                                                                                                                                                                                         
*  IF .NOT. EOF()                                                                                                                                                                                                                                      
*    IF FOUND()                                                                                                                                                                                                                                       
*      IF Rec_LOCK(0)                                                                                                                                                                                                                                   
*        REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                                 
*        REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                                      
*        REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                              
*      ENDIF                                                                                                                                                                                                                                                   
*      UNLOCK                                                                                                                                                                                                                                                  
*    ENDIF                                                                                                                                                                                                                                            
*  ELSE                                                                                                                                                                                                                                                
*    F10='DISPOS'                                                                                                                                                                                                                                            
*    SELECT 10                                                                                                                                                                                                                                        
*    SET EXCLUSIVE OFF                                                                                                                                                                                                                                
*    USE &DR&F10 INDE &DR&F10                                                                                                                                                                                                                                
*    SEEK KDTEMP                                                                                                                                                                                                                                             
*    IF .NOT. EOF()                                                                                                                                                                                                                                          
*      IF FOUND()                                                                                                                                                                                                                                     
*        IF Rec_LOCK(0)                                                                                                                                                                                                                                 
*          REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                               
*          REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                                    
*          REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                            
*        ENDIF                                                                                                                                                                                                                                                 
*        UNLOCK                                                                                                                                                                                                                                                
*      ENDIF                                                                                                                                                                                                                                          
*    ENDIF                                                                                                                                                                                                                                                   
*  ENDIF
  TOTPHR=TOTPHR+PAYTMP                                                                                                                                                                                                                                                                                                                                                                                                                                                                               
  SELECT 6                                                                                                                                                                                                                                            
  SKIP                                                                                                                                                                                                                                                
  BR=BR+1                                                                                                                                                                                                                                             
ENDDO
* Thien added on 02nd Feb 2011 for public holiday service charge 20%
srv_charge = totphr * 0.2
totphr = totphr + srv_charge
@ BR,15 SAY "SERVICE CHARGE FOR PUBLIC HOLIDAY"
DO SAYG WITH BR,65,srv_charge,'99,999.99','99,999,999'
* End Thien
*@ 50, 40 SAY 'SUB TOTAL'
DO SAYG WITH 49,60,totphr,'99,999.99','99,999,999'
nvat=totphr*vat/100
*@ 51, 40 SAY 'VAT ' + str(vat) + '%'
DO SAYG WITH 51,60,nvat,'99,999.99','99,999,999'                                                                                                                                                                                                                                    
gtotphr=totphr+nvat
*@ 52, 40 SAY 'TOTAL VND'
DO SAYG WITH 53,60,gtotphr,'99,999.99','99,999,999'
EJECT       
SET DEVICE TO SCREEN
** END Thien
*****  ADD PRESCRIPTION TO n:\temp\phar_his AS DOCUMENTTAION
F24="\TEMP\PHAR_HIS\HISTORY.DBF"
SELE 24
USE &DR&F24
F6="\TEMP\PR"+kdpat
APPEN FROM &DR&F6
CLOSE ALL       
RETU

Procedure HEAD1                                                                                                                                                                                                                                           
*----------------                                                                                                                                                                                                                                         
*page=page+1
@  8, 36  SAY SERIAL
@  11, 12 SAY TRIM(NMPAT)+' '+TRIM(FNMPAT)
@  11, 66 SAY DATE()
@  14, 21 SAY TRIM(CORP)
@  14, 66 SAY KDPAT
@  16, 18 SAY dobpat
*@  16, 59 SAY 'Currency: ' + AEACURR                                                                                                                                                                                                                                               
*@  2, 66  SAY  a+'/'+str(MONTH(DATE()),2)+'/'+NOFT                                                                                                                                                                                                        
*@  3, 73  SAY str(page,1) + '/' + str(tot_pg,1)                                                                                                                                                                                                           
*@  6, 12  SAY DATE()                                                                                                                                                                                                                                      
*@  8, 12  SAY TIME()                                                                                                                                                                                                                                     
*@  12, 70  SAY KDPAT                                                                                                                                                                                                                                      
*@  13, 12  SAY NMPAT                                                                                                                                                                                                                                      
*@  13, 36  SAY FNMPAT                                                                                                                                                                                                                                     
																															  
